indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.1.1 v dplyr 1.0.6
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 401)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.03749 13.03321 13.02898 13.02480 13.02068 13.01660 13.01257 13.00859
## [9] 13.00466 13.00077 12.99693 12.99315 12.98940 12.98571 12.98206 12.97846
## [17] 12.97490 12.97139 12.96793 12.96451 12.96113 12.95780 12.95451 12.95127
## [25] 12.94807 12.94491 12.94180 12.93873 12.93570 12.93271 12.92976 12.92686
## [33] 12.92399 12.92117 12.91838 12.91564 12.91294 12.91030 12.90771 12.90518
## [41] 12.90270 12.90028 12.89791 12.89560 12.89334 12.89113 12.88898 12.88688
## [49] 12.88484 12.88285 12.88092 12.87903 12.87720 12.87543 12.87371 12.87204
## [57] 12.87042 12.86886 12.86735 12.86589 12.86449 12.86314 12.86184 12.86059
## [65] 12.85940 12.85826 12.85717 12.85613 12.85515 12.85421 12.85333 12.85250
## [73] 12.85172 12.85100 12.85032 12.84970 12.84912 12.84860 12.84815 12.84778
## [81] 12.84749 12.84728 12.84714 12.84708 12.84710 12.84719 12.84734 12.84757
## [89] 12.84786 12.84821 12.84863 12.84911 12.84964 12.85023 12.85088 12.85158
## [97] 12.85233 12.85312 12.85397 12.85485 12.85579 12.85676 12.85777 12.85882
## [105] 12.85990 12.86102 12.86217 12.86335 12.86455 12.86578 12.86704 12.86832
## [113] 12.86961 12.87093 12.87226 12.87360 12.87496 12.87633 12.87770 12.87908
## [121] 12.88074 12.88293 12.88560 12.88871 12.89223 12.89612 12.90033 12.90483
## [129] 12.90958 12.91454 12.91967 12.92494 12.93029 12.93570 12.94112 12.94651
## [137] 12.95184 12.95707 12.96215 12.96705 12.97173 12.97614 12.98026 12.98403
## [145] 12.98743 12.99041 12.99293 12.99632 13.00178 13.00911 13.01806 13.02844
## [153] 13.04000 13.05255 13.06585 13.07968 13.09383 13.10808 13.12220 13.13597
## [161] 13.14918 13.16161 13.17303 13.18322 13.19197 13.19906 13.20426 13.20736
## [169] 13.20957 13.21225 13.21534 13.21878 13.22253 13.22654 13.23074 13.23510
## [177] 13.23956 13.24406 13.24855 13.25299 13.25732 13.26150 13.26545 13.26915
## [185] 13.27253 13.27554 13.27813 13.28025 13.28185 13.28287 13.28327 13.28299
## [193] 13.28198 13.28019 13.27756 13.27405 13.26960 13.26417 13.25753 13.24954
## [201] 13.24027 13.22976 13.21809 13.20529 13.19144 13.17659 13.16080 13.14412
## [209] 13.12661 13.10833 13.08934 13.06970 13.04945 13.02867 13.00741 12.98572
## [217] 12.96366 12.94129 12.91867 12.89586 12.87291 12.84987 12.82682 12.80380
## [225] 12.78088 12.75810 12.73554 12.71324 12.69126 12.66966 12.64850 12.62784
## [233] 12.60773 12.58823 12.56940 12.55130 12.53398 12.51750 12.50086 12.48312
## [241] 12.46440 12.44481 12.42449 12.40354 12.38210 12.36029 12.33822 12.31602
## [249] 12.29382 12.27173 12.24987 12.22838 12.20736 12.18695 12.16726 12.14841
## [257] 12.13054 12.11375 12.09818 12.08382 12.07053 12.05820 12.04676 12.03611
## [265] 12.02615 12.01678 12.00793 11.99948 11.99136 11.98346 11.97569 11.96797
## [273] 11.96019 11.95226 11.94408 11.93558 11.92665 11.91719 11.90712 11.89634
## [281] 11.88515 11.87392 11.86267 11.85140 11.84013 11.82887 11.81764 11.80644
## [289] 11.79530 11.78423 11.77324 11.76234 11.75154 11.74086 11.73032 11.71992
## [297] 11.70968 11.69962 11.68974 11.68005 11.67058 11.66134 11.65233 11.64358
## [305] 11.63509 11.62688 11.61897 11.61136 11.60406 11.59710 11.59049 11.58423
## [313] 11.57834 11.57284 11.56774 11.56305 11.55878 11.55452 11.54987 11.54492
## [321] 11.53974 11.53441 11.52900 11.52360 11.51828 11.51312 11.50818 11.50356
## [329] 11.49933 11.49557 11.49234 11.48973 11.48782 11.48668 11.48639 11.48703
## [337] 11.48867 11.49140 11.49473 11.49818 11.50177 11.50552 11.50947 11.51365
## [345] 11.51808 11.52278 11.52780 11.53315 11.53887 11.54497 11.55150 11.55847
## [353] 11.56592 11.57388 11.58236 11.59141 11.60104 11.61129 11.62218 11.63361
## [361] 11.64549 11.65779 11.67053 11.68371 11.69732 11.71136 11.72584 11.74076
## [369] 11.75611 11.77190 11.78813 11.80479 11.82190 11.83944 11.85742 11.87584
## [377] 11.89469 11.91399 11.93373 11.95390 11.97452 11.99558 12.01708 12.03902
## [385] 12.06140 12.08423 12.10750 12.13121 12.15536 12.17996 12.20500 12.23049
## [393] 12.25642 12.28279 12.30962 12.33688 12.36460 12.39276 12.42136 12.45041
## [401] 12.47992#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 401)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.56167 12.55951 12.55740 12.55533 12.55330 12.55133 12.54940 12.54752
## [9] 12.54569 12.54391 12.54219 12.54052 12.53891 12.53735 12.53585 12.53441
## [17] 12.53303 12.53172 12.53046 12.52927 12.52814 12.52709 12.52609 12.52517
## [25] 12.52432 12.52354 12.52283 12.52219 12.52163 12.52114 12.52074 12.52041
## [33] 12.52016 12.51999 12.51990 12.51990 12.51997 12.52013 12.52035 12.52066
## [41] 12.52104 12.52149 12.52201 12.52260 12.52327 12.52400 12.52481 12.52568
## [49] 12.52662 12.52762 12.52869 12.52982 12.53102 12.53228 12.53360 12.53499
## [57] 12.53643 12.53793 12.53949 12.54111 12.54279 12.54452 12.54630 12.54814
## [65] 12.55003 12.55198 12.55397 12.55602 12.55811 12.56026 12.56245 12.56469
## [73] 12.56698 12.56931 12.57168 12.57410 12.57656 12.57907 12.58170 12.58456
## [81] 12.58762 12.59089 12.59435 12.59799 12.60181 12.60580 12.60994 12.61423
## [89] 12.61866 12.62323 12.62792 12.63272 12.63762 12.64263 12.64772 12.65289
## [97] 12.65813 12.66343 12.66879 12.67419 12.67963 12.68509 12.69057 12.69606
## [105] 12.70155 12.70704 12.71250 12.71794 12.72335 12.72872 12.73403 12.73928
## [113] 12.74446 12.74957 12.75459 12.75951 12.76433 12.76904 12.77362 12.77808
## [121] 12.78286 12.78836 12.79451 12.80124 12.80847 12.81612 12.82413 12.83241
## [129] 12.84089 12.84951 12.85817 12.86681 12.87535 12.88372 12.89184 12.89964
## [137] 12.90704 12.91397 12.92036 12.92612 12.93118 12.93547 12.94006 12.94595
## [145] 12.95302 12.96110 12.97005 12.97974 12.99000 13.00070 13.01168 13.02281
## [153] 13.03393 13.04490 13.05558 13.06581 13.07545 13.08436 13.09238 13.09938
## [161] 13.10520 13.10970 13.11273 13.11530 13.11845 13.12215 13.12632 13.13093
## [169] 13.13591 13.14122 13.14679 13.15259 13.15854 13.16461 13.17073 13.17685
## [177] 13.18292 13.18889 13.19470 13.20030 13.20564 13.21065 13.21530 13.21952
## [185] 13.22326 13.22647 13.22909 13.23108 13.23237 13.23292 13.23267 13.23157
## [193] 13.22956 13.22659 13.22261 13.21756 13.21107 13.20287 13.19304 13.18168
## [201] 13.16885 13.15466 13.13919 13.12252 13.10475 13.08595 13.06621 13.04563
## [209] 13.02428 13.00226 12.97965 12.95653 12.93300 12.90914 12.88503 12.86077
## [217] 12.83643 12.81211 12.78789 12.76387 12.74011 12.71672 12.69377 12.67136
## [225] 12.64957 12.62849 12.60820 12.58880 12.57035 12.55297 12.53672 12.52170
## [233] 12.50799 12.49451 12.48018 12.46509 12.44935 12.43304 12.41628 12.39914
## [241] 12.38173 12.36414 12.34648 12.32883 12.31129 12.29396 12.27694 12.26032
## [249] 12.24420 12.22867 12.21384 12.19979 12.18662 12.17443 12.16343 12.15368
## [257] 12.14505 12.13743 12.13070 12.12475 12.11945 12.11469 12.11035 12.10632
## [265] 12.10246 12.09867 12.09483 12.09081 12.08651 12.08180 12.07656 12.07068
## [273] 12.06404 12.05651 12.04799 12.03977 12.03313 12.02790 12.02393 12.02108
## [281] 12.01918 12.01808 12.01763 12.01768 12.01806 12.01863 12.01922 12.01969
## [289] 12.01989 12.01965 12.01882 12.01725 12.01478 12.01127 12.00655 12.00047
## [297] 11.99287 11.98380 11.97342 11.96192 11.94946 11.93621 11.92233 11.90801
## [305] 11.89341 11.87870 11.86404 11.84962 11.83561 11.82216 11.80945 11.79766
## [313] 11.78694 11.77748 11.76944 11.76299 11.75831 11.75425 11.74963 11.74453
## [321] 11.73904 11.73325 11.72725 11.72112 11.71495 11.70883 11.70286 11.69710
## [329] 11.69166 11.68662 11.68206 11.67809 11.67477 11.67221 11.67049 11.66969
## [337] 11.66990 11.67122 11.67310 11.67498 11.67687 11.67883 11.68087 11.68304
## [345] 11.68536 11.68788 11.69062 11.69361 11.69690 11.70051 11.70448 11.70884
## [353] 11.71363 11.71887 11.72460 11.73086 11.73768 11.74508 11.75312 11.76166
## [361] 11.77059 11.77989 11.78958 11.79964 11.81008 11.82091 11.83211 11.84369
## [369] 11.85565 11.86799 11.88070 11.89380 11.90728 11.92113 11.93536 11.94997
## [377] 11.96496 11.98033 11.99608 12.01220 12.02870 12.04558 12.06284 12.08048
## [385] 12.09850 12.11689 12.13566 12.15481 12.17434 12.19424 12.21453 12.23519
## [393] 12.25622 12.27764 12.29943 12.32160 12.34415 12.36707 12.39037 12.41405
## [401] 12.43811#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 401)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 12.03138 12.02537 12.01946 12.01363 12.00789 12.00225 11.99670 11.99123
## [9] 11.98586 11.98057 11.97538 11.97027 11.96525 11.96033 11.95549 11.95074
## [17] 11.94607 11.94150 11.93702 11.93262 11.92831 11.92409 11.91995 11.91590
## [25] 11.91194 11.90807 11.90428 11.90058 11.89696 11.89344 11.88999 11.88664
## [33] 11.88337 11.88018 11.87708 11.87406 11.87113 11.86829 11.86552 11.86285
## [41] 11.86025 11.85774 11.85532 11.85300 11.85082 11.84876 11.84684 11.84504
## [49] 11.84336 11.84181 11.84038 11.83907 11.83787 11.83679 11.83582 11.83497
## [57] 11.83422 11.83358 11.83304 11.83261 11.83228 11.83205 11.83191 11.83187
## [65] 11.83193 11.83207 11.83230 11.83263 11.83303 11.83352 11.83410 11.83475
## [73] 11.83548 11.83628 11.83716 11.83811 11.83914 11.84022 11.84138 11.84260
## [81] 11.84388 11.84522 11.84662 11.84807 11.84958 11.85115 11.85277 11.85446
## [89] 11.85621 11.85803 11.85991 11.86186 11.86388 11.86597 11.86813 11.87036
## [97] 11.87268 11.87507 11.87753 11.88008 11.88271 11.88542 11.88822 11.89111
## [105] 11.89408 11.89714 11.90029 11.90354 11.90688 11.91031 11.91384 11.91747
## [113] 11.92120 11.92503 11.92897 11.93301 11.93716 11.94141 11.94577 11.95025
## [121] 11.95484 11.95954 11.96435 11.96929 11.97434 11.97951 11.98550 11.99291
## [129] 12.00160 12.01145 12.02231 12.03405 12.04653 12.05963 12.07320 12.08711
## [137] 12.10123 12.11542 12.12955 12.14348 12.15708 12.17021 12.18274 12.19453
## [145] 12.20545 12.21536 12.22413 12.23409 12.24741 12.26374 12.28273 12.30402
## [153] 12.32727 12.35211 12.37819 12.40516 12.43266 12.46035 12.48786 12.51485
## [161] 12.54096 12.56583 12.58912 12.61046 12.62951 12.64592 12.65931 12.66936
## [169] 12.67777 12.68650 12.69548 12.70467 12.71401 12.72346 12.73296 12.74246
## [177] 12.75192 12.76127 12.77047 12.77947 12.78821 12.79665 12.80474 12.81242
## [185] 12.81964 12.82635 12.83250 12.83804 12.84292 12.84708 12.85048 12.85307
## [193] 12.85478 12.85559 12.85542 12.85423 12.85197 12.84859 12.84369 12.83696
## [201] 12.82847 12.81832 12.80658 12.79333 12.77866 12.76265 12.74537 12.72692
## [209] 12.70737 12.68680 12.66530 12.64295 12.61983 12.59601 12.57160 12.54665
## [217] 12.52127 12.49552 12.46949 12.44327 12.41693 12.39055 12.36422 12.33802
## [225] 12.31203 12.28633 12.26101 12.23614 12.21181 12.18810 12.16509 12.14287
## [233] 12.12150 12.10109 12.08170 12.06342 12.04633 12.03052 12.01513 11.99930
## [241] 11.98309 11.96653 11.94969 11.93262 11.91536 11.89797 11.88050 11.86300
## [249] 11.84552 11.82812 11.81085 11.79375 11.77688 11.76029 11.74403 11.72815
## [257] 11.71271 11.69776 11.68334 11.66946 11.65606 11.64311 11.63057 11.61842
## [265] 11.60661 11.59512 11.58392 11.57296 11.56222 11.55167 11.54127 11.53098
## [273] 11.52078 11.51063 11.50051 11.49036 11.48018 11.46991 11.45953 11.44900
## [281] 11.43846 11.42806 11.41781 11.40771 11.39777 11.38798 11.37836 11.36892
## [289] 11.35965 11.35056 11.34166 11.33295 11.32444 11.31612 11.30802 11.30012
## [297] 11.29244 11.28499 11.27776 11.27076 11.26400 11.25748 11.25121 11.24518
## [305] 11.23942 11.23392 11.22868 11.22371 11.21903 11.21462 11.21050 11.20667
## [313] 11.20314 11.19991 11.19699 11.19438 11.19208 11.18979 11.18723 11.18445
## [321] 11.18151 11.17848 11.17542 11.17238 11.16943 11.16663 11.16404 11.16171
## [329] 11.15970 11.15809 11.15692 11.15626 11.15616 11.15670 11.15792 11.15989
## [337] 11.16267 11.16632 11.17043 11.17458 11.17881 11.18314 11.18761 11.19224
## [345] 11.19706 11.20211 11.20741 11.21300 11.21890 11.22514 11.23176 11.23879
## [353] 11.24626 11.25419 11.26261 11.27157 11.28108 11.29117 11.30189 11.31312
## [361] 11.32473 11.33672 11.34910 11.36187 11.37502 11.38855 11.40247 11.41678
## [369] 11.43147 11.44655 11.46201 11.47786 11.49410 11.51072 11.52772 11.54512
## [377] 11.56290 11.58106 11.59961 11.61855 11.63788 11.65759 11.67769 11.69818
## [385] 11.71905 11.74031 11.76196 11.78400 11.80642 11.82923 11.85243 11.87602
## [393] 11.90000 11.92436 11.94911 11.97426 11.99978 12.02570 12.05201 12.07870
## [401] 12.10579#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")